SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00007 1 05-25-9408:04ALL DAVID ADAMSON IOResult Codes SWAG9405 29 ┤φ πunit CustExit;π(*--------------------------------------------------------------------------π Original source code by David Drzyzga, FidoNet 1:2619/209, SysOp ofπ =>> CUTTER JOHN'S <<= (516) 234-1737 [HST/DS/v32bis/v32ter]π Offered to the public domain 04-04-1994π---------------------------------------------------------------------------*)πinterfaceπimplementationπusesπ Crt;πvarπ ExitAddress : pointer;π{$F+}πprocedure ErrorExit;π{$F-}πbeginπ if ErrorAddr <> Nil then beginπ NormVideo;π ClrScr;π Writeln('Program terminated with error number ', ExitCode:3, '.');π case ExitCode ofπ 1..18 : write( ^G + 'DOS ERROR: ');π 100..106 : write( ^G + 'I/O ERROR: ');π 150..162,π 200..216 : write( ^G + 'CRITICAL ERROR: ');π end;π Case ExitCode ofπ 1 : Writeln('Invalid function number.');π 2 : Writeln('File not found.');π 3 : Writeln('Path not found.');π 4 : Writeln('Too many open files.');π 5 : Writeln('File access denied.');π 6 : Writeln('Invalid file handle.');π 12 : Writeln('Invalid file access code.');π 15 : Writeln('Invalid drive number.');π 16 : Writeln('Cannot remove current directory.');π 17 : Writeln('Cannot rename across drives.');π 18 : Writeln('No More Files.');π 100 : Writeln('Disk read error.');π 101 : Writeln('Disk write error.');π 102 : Writeln('File not assigned.');π 103 : Writeln('File not open.');π 104 : Writeln('File not open for input.');π 105 : Writeln('File not open for output.');π 106 : Writeln('Invalid numeric format.');π 150 : Writeln('Disk is write-protected.');π 151 : Writeln('Unknown unit.');π 152 : Writeln('Drive not ready.');π 153 : Writeln('Unknown command.');π 154 : Writeln('CRC error in data.');π 155 : Writeln('Bad drive request structure length.');π 156 : Writeln('Disk seek error.');π 157 : Writeln('Unknown media type.');π 158 : Writeln('Sector not found.');π 159 : Writeln('Printer out of paper.');π 160 : Writeln('Device write fault.');π 161 : Writeln('Device read fault.');π 162 : Writeln('Hardware failure.');π 200 : Writeln('Division by zero.');π 201 : Writeln('Range check error.');π 202 : Writeln('Stack overflow error.');π 203 : Writeln('Heap overflow error.');π 204 : Writeln('Invalid pointer operation.');π 205 : Writeln('Floating point overflow.');π 206 : Writeln('Floating point underflow.');π 207 : Writeln('Invalid floating point operation.');π 208 : Writeln('Overlay manager not installed.');π 209 : Writeln('Overlay file read error.');π 210 : Writeln('Object not initialized.');π 211 : Writeln('Call to abstract method.');π 212 : Writeln('Stream registration error.');π 213 : Writeln('Collection index out of range.');π 214 : Writeln('Collection overflow error.');π 215 : Writeln('Arithmetic overflow error.');π 216 : Writeln('General Protection fault.');π elseπ Writeln( ^G + 'Unknown Error.');π end; { Case }π ErrorAddr := Nil;π end;π Exitproc := ExitAddress; { Restore original exit address }πend; { ErrorExit }πbeginπ ExitAddress := ExitProc; { Save original exit address }π ExitProc := @ErrorExit; { Install custom exit procedure }πend. { Unit CustExit }π 2 05-25-9408:17ALL DAVID DUNSON Lockup! SWAG9405 7 ┤φ {πHello All!ππHere's a little procedure that just poped into mind. It's a good way toπprevent unathorized usage of a certain task.ππ{ ------- CUT HERE ------- }ππProgram LockItUp;ππConstπ Lock = $1234;ππProcedure Lockup(Key: Word); Assembler;πASMπ MOV CX, Keyπ SUB CX, Lockπ@@1: INC CXπ LOOP @@1πEnd;ππBeginπ Lockup($1234);π WriteLn('Key works!');πEnd.ππ{ ------- CUT HERE ------- }ππYou could give someone a registration code who's CRC value will result in theπsame value as your Lock and if an incorrect value is entered, their system willπlock up (at least that task will).ππTry running the program with Lockup($1235) and see what happens. (Make sureπyou don't have anything important in memory!)ππJust an idea..ππ 3 05-25-9408:20ALL WIN VAN DER VEGT No DOS Shell SWAG9405 60 ┤φ {πEver been in a situation where you want to secure a PC (for example in aπnetwork environment) by using menus from which you can't exit andπuser/software companies keep coming with software with the Shell to DOSπoption?ππHere's a simple solution which works with a lot of programs which shellπby using COMSPEC.ππThis program called execute patches it's own environment with aπreplacement COMSPEC, Does an EXEC and restores the original environment.πIt's done by making fetching all environment strings, replace comspecπwith the first commandline parameter (which should be shorter than theπoriginal comspec, so I use the program called EXIT located in theπsame directory as COMMAND.COM). Than it does an plain TP Exec (withoutπswapping to EMS/XMS/DISK etc) of the second commandline parameter withπthe rest of the commandline as it's parameters.ππI used patching the original environment of EXECUTE because the programπexecuted inherits it and EXECUTE needs comspec only to exit itself (andπreturn to a menu for example). Because of this construction it'sπpossible to exit the program started normally and return to a menu butπyou'll be unable to shell to dos and type something like FORMAT C:.ππAn example EXIT.PAS is also supplied. Pressing CTRL-BREAK etc doesn'tπmatter, you'll always return to the application from which you tried toπshell. Beware that some programs like SPSS and VP-Planner haveπdifficulties with R/O attributes on EXIT.EXE (and COMMAND.COM), so keepπit R/W.ππSo to for example disable the Turbo Pascal File/Dos use :ππEXECUTE C:\DOS\EXIT.EXE C:\TURBO55\TURBO.EXE TEST.PASππinstead ofππC:\TURBO55\TURBO TEST.PASππIf COMSPEC was C:\DOS\COMMAND.COM and Turbo Pascal was located inπthe C:\TURBO55 directory.πππRemember the extensions .EXE or .COM are necessary!ππ------------------------<cut hereππ{---------------------------------------------------------}π{ Project : Exec with Temporaryly changed 'COMSPEC' }π{ : the exec routine itself }π{ Auteur : Ir. G.W. van der Vegt }π{---------------------------------------------------------}π{ Datum .tijd Revisie }π{ 921118.0930 Creatie. }π{---------------------------------------------------------}π{ This program patches the COMSPEC environment variable }π{ with a new value (ie EXIT.EXE) and executes the }π{ program. After execution it restores the environment }π{ }π{ Syntax : }π{ }π{ EXECUTE temporary_comspec program_name [paramaters] }π{ }π{ Limits :-Only maxenv environments strings can be stored,}π{ each with a maximum length of 128 characters. }π{ -The temporary comspec must be shorter than the }π{ original one. }π{ -Environment must be smaller than 32k }π{---------------------------------------------------------}ππ{$M 4096,0,0}ππProgram Execute;ππUsesπ Crt,π Dos;πππConstπ Maxenv = 64;ππTypeπ psp = Recordπ int20adr : Word;π endofmem : Word;π res1 : Byte;π callfar : Array[1..5] OF Byte;π int22 : Pointer;π Int23 : Pointer;π Int24 : Pointer;π parentpsp: Word;π handles : Array[1..20] OF Byte;π envseg : Word;π {----More follows}π End;ππ env = array[1..32678] OF Char;ππVarπ e : ^env;π p : ^psp;π addcnt : Word; {----no of additional strings}π i : Integer; {----loop counter}π envar : Array[1..maxenv] of String[128];{----environment string storage}π noenv : Integer; {----no strings in environment}π cmdline: STRING; {----command line of program to start}π comspec: STRING; {----original comspec storage}π ch : CHAR;ππ{---------------------------------------------------------}ππProcedure Read_env;ππVarπ i,k : Integer;ππbeginπ p:=Ptr(prefixseg,0);π noenv:=0;ππ{----Show environment strings}π e:=Ptr(p^.envseg,0);π i:=1;π Inc(noenv);π envar[noenv]:='';π Repeatπ If (e^[i]<>#0)π Then envar[noenv]:=envar[noenv]+e^[i]π Elseπ Beginπ Inc(noenv);π If (noenv>=maxenv)π THENπ BEGINπ Writeln('Only ',maxenv:0,' environment strings can be stored.');π Halt;π END;ππ envar[noenv]:='';π End;π Inc(i);π Until (e^[i]=#00) AND (e^[i]=e^[i-1]);ππ{----Show Additional environment strings}π Inc(i);π addcnt:=Word(Ord(e^[i])+256*Ord(e^[i+1]));π Inc(i);π Inc(i); {----eerste character additional strings}π k:=addcnt;ππ If (noenv+addcnt>=maxenv)π THENπ BEGINπ Writeln('Only ',maxenv:0,' (additional)environment strings can be stored');π Halt;π END;ππ Repeatπ If (e^[i]<>#0)π Then envar[noenv]:=envar[noenv]+e^[i]π Elseπ Beginπ Inc(noenv);π envar[noenv]:='';π Dec(k);π End;π Inc(i);π Until (k<=0);ππ dec(noenv);ππ {Writeln(' Environment Strings : ',noenv-addcnt);π for j:=1 to noenv-addcnt doπ writeln('e ',envar[j]);π Writeln(' Additional Strings : ',addcnt);π for j:=noenv-addcnt+1 to noenv doπ writeln('a ',envar[j]);π writeln;}πend; {of Read_env}ππ{---------------------------------------------------------}ππProcedure Patch_env(envst,newval : STRING);ππVarπ i,j,k : Integer;ππBEGINπ{----change an envronment string}π for i:=1 to noenv doπ beginπ if (pos(envst+'=',envar[i])=1)π THENπ beginπ Delete(envar[i],Pos('=',envar[i])+1,Length(envar[i])-Pos('=',envar[i]));π envar[i]:=envar[i]+newval;π end;π end;ππ{----patch environment strings}π i:=1;π for j:=1 to noenv-addcnt doπ beginπ for k:=1 to Length(envar[j]) doπ beginπ e^[i]:=envar[j][k];π inc(i);π end;π e^[i]:=#0;π inc(i);π end;ππ{----patch environment string end}π e^[i]:=#0; inc(i);π{----patch additional string count}π e^[i]:=Chr(addcnt mod 256); inc(i);π e^[i]:=Chr(addcnt div 256); inc(i);ππ{----patch additional strings}π for j:=noenv-addcnt+1 to noenv doπ beginπ for k:=1 to Length(envar[j]) doπ beginπ e^[i]:=envar[j][k];π inc(i);π end;π e^[i]:=#0;π inc(i);π end;πend; {of Patch_env}ππ{---------------------------------------------------------}ππBeginπ If (Paramcount<2)π THENπ BEGINπ Writeln('Syntax : EXECUTE temporary_comspec program_name [program_param]');π Halt;π END;ππ checkbreak:=false;ππ comspec:=Getenv('COMSPEC');ππ If (Length(Paramstr(1))>Length(comspec))π THENπ BEGINπ Writeln('Path&name of temporary COMSPEC should be shorter than the original');π Halt;π END;ππ Read_env;ππ Patch_env('COMSPEC',Paramstr(1));ππ cmdline:='';π FOR i:=3 to Paramcount DOπ cmdline:=cmdline+' '+Paramstr(i);ππ Swapvectors;π Exec(Paramstr(2),cmdline);π Swapvectors;ππ WHILE Keypressed DO ch:=Readkey;ππ Patch_env('COMSPEC','C:\COMMAND.COM');πend.πππ------------------------<cut hereπππProgram Exit;ππUsesπ CRT;ππBeginπ Clrscr;π GotoXY(20,12);π Write('Sorry, SHELLing to DOS not Possible.');πEnd.π 4 05-25-9408:22ALL GREG ESTABROOKS Dos Prompt SWAG9405 30 ┤φ π{π There are 2 ways that I can think of off hand. One is to executeπ COMMAND.COM with the parameter '/K PROMPT [Whatever]' OR You couldπ create your own program enviroment and then add/edit as many enviromentπ variables as you have memory for. The following program demonstratesπ this. It creates its own enviroment , then copies the old info to itπ but changes the prompt to whatever you want. After the shell itπ releases the memory:π}ππ{***********************************************************************}πPROGRAM PromptDemo; { Apr 18/94, Greg Estabrooks. }π{$M 16840,0,0} { Reserved some memory for the shell. }πUSES CRT, { IMPORT Clrscr,Writeln. }π DOS; { IMPORT Exec. }ππPROCEDURE ShellWithPrompt( Prompt :STRING );π { Routine to allocate a temporary Enviroment }π { with our prompt and the execute COMMAND.COM. }π { NOTE: This does NO error checking. }πVARπ NewEnv :WORD; { Points to our newly allocated env. }π OldEnv :WORD; { Holds Old Env Segment. }π EnvPos :WORD; { Position inside our enviroment. }π EnvLp :WORD; { Variable to loop through ENVStrings. }π TempStr:STRING; { Holds temporary EnvString info. }πBEGINπ ASMπ Mov AH,$48 { Routine to allocate memory. }π Mov BX,1024 { Allocate 1024(1k) of memory. }π Int $21 { Call DOS to allocate memory. }π Mov NewEnv,AX { Save segment address of our memory. }π END;ππ EnvPos := 0; { Initiate pos within our Env. }π FOR EnvLp := 1 TO EnvCount DO { Loop through entire enviroment. }π BEGINπ TempStr := EnvStr(EnvLp); { Retrieve Envirment string. }π IF Pos('PROMPT=',TempStr) <> 0 THEN { If its our prompt THEN .... }π TempStr := 'PROMPT='+Prompt+#0 { Create our new prompt. }π ELSE { .... otherwise......... }π TempStr := TempStr + #0; { Add NUL to make it ASCIIZ compatible. }π Move(TempStr[1],Mem[NewEnv:EnvPos],Length(TempStr)); { Put in Env. }π INC(EnvPos,Length(TempStr)); { Point to new position in Enviroment. }π END;{For}ππ OldEnv := MemW[PrefixSeg:$2C];{ Save old enviroment segment. }π MemW[PrefixSeg:$2C] := NewEnv;{ Point to our new enviroment. }π SwapVectors; { Swap Int vectors in case of conflicts.}π Exec(GetEnv('COMSPEC'),''); { Call COMMAND.COM. }π SwapVectors; { Swap em back. }π MemW[PrefixSeg:$2C] := OldEnv;{ Point back to old enviroment. }ππ ASMπ Push ES { Save ES. }π Mov AH,$49 { Routine to deallocate memory. }π Mov ES,NewEnv { Point ES to area to deallocate. }π Int $21; { Call DOS to free memory. }π Pop ES { Restore ES. }π END;πEND;{ShellWithPrompt}ππBEGINπ Clrscr; { Clear the screen. }π Writeln('Type EXIT to return');{ Show message on how to exit shell. }π ShellWithPrompt('[PromptDemo] $P$G'); { shell to DOS with our prompt. }πEND.{PromptDemo}π{***********************************************************************}π 5 05-25-9408:22ALL THOMAS SKOGESTAD Customizing Run-Time! SWAG9405 37 ┤φ πUnit SHOWREM;π{Show Runtime Error Messages}π{Written by C. Enders (1994)}π{Usage : Write the next line in your Main pascal program.π Uses Showrem;π This unit provides the meaning of the error codes while you are runningπ your pascal programs. If other users are using your program they getπ frustrated if they see a message likeπ Runtime error 200: at 1234:abcd.π This unit let your program show error messages like :π Runtime Error 200: Division by zero.π Use of this program is free and no royalties must be paid if you use thisπ routines in your (commercial) programs (perhaps some credits like thanksπ to ...).π If you need any help e-mail at C.W.G.M.ENDERS@KUB.NLπ}ππInterFaceππImplementationππProcedure WriteErrormessage;πBeginπ Writeln;π Case Exitcode ofπ 1 : Writeln('Runtime Error ',exitcode,': ','Invalid function number.');π 2 : Writeln('Runtime Error ',exitcode,': ','File not found.');π 3 : Writeln('Runtime Error ',exitcode,': ','Path not found.');π 4 : Writeln('Runtime Error ',exitcode,': ','Too many open files.');π 5 : Writeln('Runtime Error ',exitcode,': ','File access denied.');π 6 : Writeln('Runtime Error ',exitcode,': ','Invalid file handle.');π 12 : Writeln('Runtime Error ',exitcode,': ','Invalid file access code.');π 15 : Writeln('Runtime Error ',exitcode,': ','Invalid drive number.');π 16 : Writeln('Runtime Error ',exitcode,': ','Cannot remove currentπdirectory.');π 17 : Writeln('Runtime Error ',exitcode,': ','Cannot rename acrossπdrives.');π 18 : Writeln('Runtime Error ',exitcode,': ','No more files.');π 100 : Writeln('Runtime Error ',exitcode,': ','Disk read error.');π 101 : Writeln('Runtime Error ',exitcode,': ','Disk write error.');π 102 : Writeln('Runtime Error ',exitcode,': ','File not assigned.');π 103 : Writeln('Runtime Error ',exitcode,': ','File not open.');π 104 : Writeln('Runtime Error ',exitcode,': ','File not open for input.');π 105 : Writeln('Runtime Error ',exitcode,': ','File not open for output.');π 106 : Writeln('Runtime Error ',exitcode,': ','Invalid numeric format.');π 150 : Writeln('Runtime Error ',exitcode,': ','Disk is write-protected.');π 151 : Writeln('Runtime Error ',exitcode,': ','Bad drive request structπlength.');π 152 : Writeln('Runtime Error ',exitcode,': ','Drive not ready.');π 154 : Writeln('Runtime Error ',exitcode,': ','CRC error in data.');π 156 : Writeln('Runtime Error ',exitcode,': ','Disk seek error.');π 157 : Writeln('Runtime Error ',exitcode,': ','Unknown media type.');π 158 : Writeln('Runtime Error ',exitcode,': ','Sector Not Found.');π 159 : Writeln('Runtime Error ',exitcode,': ','Printer out of paper.');π 160 : Writeln('Runtime Error ',exitcode,': ','Device write fault.');π 161 : Writeln('Runtime Error ',exitcode,': ','Device read fault.');π 162 : Writeln('Runtime Error ',exitcode,': ','Hardware failure.');π 200 : Writeln('Runtime Error ',exitcode,': ','Division by zero.');π 201 : Writeln('Runtime Error ',exitcode,': ','Range check error.');π 202 : Writeln('Runtime Error ',exitcode,': ','Stack overflow error.');π 203 : Writeln('Runtime Error ',exitcode,': ','Heap overflow error.');π 204 : Writeln('Runtime Error ',exitcode,': ','Invalid pointer operation.');π 205 : Writeln('Runtime Error ',exitcode,': ','Floating point overflow.');π 206 : Writeln('Runtime Error ',exitcode,': ','Floating point underflow.');π 207 : Writeln('Runtime Error ',exitcode,': ','Invalid floating point operation.');π 208 : Writeln('Runtime Error ',exitcode,': ','Overlay manager not installed.');π 209 : Writeln('Runtime Error ',exitcode,': ','Overlay file read error.');π 210 : Writeln('Runtime Error ',exitcode,': ','Object not initialized.');π 211 : Writeln('Runtime Error ',exitcode,': ','Call to abstract method.');π 212 : Writeln('Runtime Error ',exitcode,': ','Stream registration error.');π 213 : Writeln('Runtime Error ',exitcode,': ','Collection index out of range.');π 214 : Writeln('Runtime Error ',exitcode,': ','Collection overflow error.');π 215 : Writeln('Runtime Error ',exitcode,': ','Arithmetic overflow error.');π 216 : Writeln('Runtime Error ',exitcode,': ','General Protection fault.');π End; {case}π ErrorAddr := Nil; {This can be Nil, if so you borland IDE will notπ display the Runtime Error Message}πEnd; {WriteErrorMessage}ππProcedure InitError;πBeginπ ExitProc := @WriteErrormessage;πEnd;{InitError}ππBegin{Body}π InitError;πEnd.π 6 05-26-9406:19ALL LARRY HADLEY Which Compiler SWAG9405 93 ┤φ {πHi !ππ Here is some source code I acquired from a Pascal echo some timeπ ago. It shows one method of detecting which TP compiler createdπ an .EXE:ππ-------------------------------------------------------------------π{ to compile type: tpc foo.pas }π{ exe: 9776 bytes by TP5.5 }ππ{$A+,B-,E-,F-,I+,N-,O-,V+}π{$M 4500,0,0}π{$ifndef debug}π{$D-,L-,R-,S-}π{$else}π{$D+,L+,R+,S+}π{$endif}ππProgram foo;ππUsesπ DOS; { dos unit from turbo pascal }ππTYPE { normal exe file header }π EXEH = RECORDπ id, { exe signature }π Lpage, { exe file size mod 512 bytes; < 512 bytes }π Fpages, { exe file size div 512 bytes; + 1 if Lpage > 0 }π relocitems, { number of relocation table items }π size, { exe header size in 16-byte paragraphs }π minalloc, { min mem. required in additional to exe image }π maxalloc, { extra max. mem. desired beyond that requiredπ to hold exe's image }π ss, { displacement of stack segment }π sp, { initial SP register value }π chk_sum, { complemented checksum }π ip, { initial IP register value }π cs, { displacement of code segment }π ofs_rtbl, { offset to first relocation item }π ovr_num : word; { overlay numbers }π END;π { window exe file header }π WINH = RECORDπ id : word; { ignore the rest of data structures }π END;ππ str2 = string [2];π str4 = string [4];π str10 = string [10];ππCONSTπ no_error = 0; { no system error }π t = #9; { ascii: hortizon tab }π dt = t+t;π tt = t+t+t;π qt = t+t+t+t;π cr = #13#10; { ascii: carriage return and line feed }ππVARπ f : file; { source file, untyped }π exehdr : exeh; { exe header contents }π winhdr : winh; { window exe header contents }π blocks_r : word; { number of blocks actually read }ππ exe_size , { exe file length }π hdr_size , { exe header size }π img_size , { load module or exe image size }π min_xmem , { min. extra memory needed }π max_xmem , { max. extra memory wanted }π o_starup : longint; { offset to start up code }ππ dirfile : searchrec;π compressed : boolean;ππfunction Hex(B :byte) :str2;π CONST strdex :array [0..$F] of char = '0123456789ABCDEF';π BEGIN Hex := concat(strdex[B shr 4], strdex[B and $F]); END;ππfunction HexW(W :word) :str4;π VAR byt :array [0..1] of byte absolute W;π BEGIN HexW := Hex(byt[1])+Hex(byt[0]); END;ππfunction HexL(L :longint) :str10;π TYPE Cast = RECORDπ Lo :word;π Hi :word;π END;π BEGIN HexL := HexW(Cast(L).Hi)+' '+HexW(Cast(L).Lo); END;ππprocedure print_info;π CONSTπ psp_size = $100; { size of psp, bytes }π VAR i : byte;π BEGINπ hdr_size := longint(exehdr.size) shl 4; { exe header size, bytes }π img_size := longint(exe_size) - hdr_size; { exe image size, bytes }π min_xmem := longint(exehdr.minalloc) shl 4; { mim xtra mem, bytes }π max_xmem := longint(exehdr.maxalloc) shl 4; { max xtra mem, bytes }π o_starup := hdr_size + longint(exehdr.cs) shl 4π +longint(exehdr.ip); { ofs to start up code }π writeln(π qt, 'Dec':8, '':6, 'Hex', cr,π 'EXE file size:', tt, exe_size:8, '':3, hexl(exe_size), cr,π 'EXE header size:', dt, hdr_size:8, '':3, hexl(hdr_size), cr,π 'Code + initialized data size:', t, img_size:8, '':3, hexl(img_size)π );ππ writeln(π 'Pre-relocated SS:SP', tt, '':3, hexw(exehdr.ss), ':', hexw(exehdr.sp)π , cr,π 'Pre-relocated CS:IP', tt, '':3, hexw(exehdr.cs), ':', hexw(exehdr.ip)π );ππ writeln(π 'Min. extra memory required:', t, min_xmem:8, '':3, hexl(min_xmem), cr,π 'Max. extra memory wanted:', t, max_xmem:8, '':3, hexl(max_xmem), cr,π 'Offset to start up code:', dt, '':3, hexl(o_starup), cr,π 'Offset to relocation table:', dt, '':3, hexw(exehdr.ofs_rtbl):9π );ππ writeln(π 'Number of relocation pointers:', t, exehdr.relocitems:8, cr,π 'Number of MS overlays:', dt, exehdr.ovr_num:8, cr,π 'File checksum value:', tt, '':3, hexw(exehdr.chk_sum):9, cr,π 'Memory needed to start:', dt, img_size+min_xmem+psp_size:8π );πEND; { print_info }ππprocedure id_signature; { the core of this program }π CONSTπ o_01 = 14; { relative offset from cstr0 to cstr1 }π o_02 = 16; { " " " cstr0 to cstr2 }π o_03 = 47; { " " " cstr0 to cstr3 }π cstr0 = 'ntime'; { constant string existed in v4-6 }π cstr1 = 'at '#0'.'; { constant string existed in v4-6 }π cstr2 = '$4567'; { constant string existed in v5-6 }π cstr3 = '83,90'; { constant string existed in v6 only }π strlen = 5; { length of cstr? }π ar_itm = 3; { items+1 of string array }ππ { the following figures have been turn-up explicitly andπ should not be changed }ππ ofs_rte = 25 shl 4; { get close to 'run time error' str contants }π maxchar = 11 shl 4; { max. size of buffer; for scanning }ππ TYPEπ arstr = array [0..ar_itm] of string[strlen];π arbuf = array [0..maxchar] of char;ππ VARπ i, j, k : word; { index counter for array buffer }π cstr : arstr; { signatures generated by tp compiler }π o_fseg : word; { to hold segment value of any far call }π o_sysseg: longint; { offset to tp system_unit_segment }π buffer : arbuf; { searching for target strings }ππ BEGINπ{d} Seek(f, o_starup + 3); { move file pointer πforward 3 bytes }π{d} BlockRead(f, o_fseg, sizeof(o_fseg)); { get far call segment πvalue }π o_sysseg := longint(o_fseg) shl 4 +hdr_size; { ofs to system obj code }π if (o_sysseg + ofs_rte <= dirfile.size) thenπ BEGINπ{d} Seek(f, o_sysseg+ofs_rte); { offset nearby tp πsignatures }π{d} BlockRead(f, buffer, sizeof(buffer), blocks_r);π for i := 0 to ar_itm doπ BEGINπ cstr[i][0] := char(strlen);π fillchar(cstr[i][1], strlen, '*');π END;π i := 1; j := 1; k := 0;π repeatπ if buffer[i] in ['n','t','i','m','e'] thenπ BEGINπ if (k > 0) and (k = i - 1) thenπ inc(j);π cstr[0][j] := buffer[i];π k := i;π END;π inc(i);π until (cstr[0] = cstr0) or (i > maxchar) or (j > strlen);π if (i+o_03 <= maxchar) thenπ BEGINπ dec(i, strlen);π move(buffer[i+o_01], cstr[1][1], strlen);π if (cstr[1] = cstr1) thenπ BEGINπ writeln(π cr, 'Offset to TP system code:', dt, '':3,π hexl(o_sysseg):9π );ππ write('Compiled by Borland TP v');ππ move(buffer[i-o_02], cstr[2][1], strlen);ππ if (cstr[2] = cstr2) thenπ BEGINπ move(buffer[i+o_03], cstr[3][1], strlen);π if (cstr[3] = cstr3) THENπ writeln('6.0')π ELSEπ writeln('5.0/5.5');π ENDπ ELSEπ writeln('4.0');π END;π END;π END;π END; {procedure}ππprocedure process_exefile;π CONSTπ ofs_whdr = $3C; { offset to MS-Window exe file id }π exwid = $454E; { MS-Window exe file id }π VARπ o_sign,π fsize :longint;π BEGINπ if (exe_size = dirfile.size) thenπ BEGINπ print_info;π if not compressed thenπ id_signature;π writeln;π ENDπ elseπ BEGINπ{d} Seek(f, ofs_whdr); { offset to 'offset to window exe πsignature' }π{d} BlockRead(f, hdr_size, sizeof(hdr_size));π{d} if (hdr_size <= dirfile.size) thenπ BEGINπ Seek(f, hdr_size); { offset to new exe signature }π{d} BlockRead(f, winhdr, sizeof(winhdr));π END;π if (winhdr.id = exwid) thenπ BEGINπ writeln('Dos/MS-Window EXE or DLL file');π print_info;π EXIT;π ENDπ elseπ BEGINπ print_info;π writeln(π cr,π 'file size (', exe_size, ') calculated from EXE header ',π '(load by DOS upon exec)', cr,π 'doesn''t match with file size (', dirfile.size, ') ',π 'recorded on file directory.', cr, cr,π '* EXE file saved with extra bytes at eof (e.g. debug info)', cr,π '* EXE file may contain overlays', cr,π '* possible a corrupted EXE file', crπ );ππ EXIT;π END;π END;π END;ππprocedure id_file;π CONSTπ exeid = $5A4D; { MS-DOS exe file id }ππ VARπ zero : str2;ππ BEGINπ if (exehdr.id = exeid) thenπ BEGINπ if (exehdr.cs = $FFF0) andπ (exehdr.ip = $0100) andπ (exehdr.ofs_rtbl = $50) orπ (exehdr.ofs_rtbl = $52) thenπ BEGINπ writeln('Compressed by PKLITE');π compressed := true;π END;π if (exehdr.size = 2) and (exehdr.chk_sum = $899D) thenπ BEGINπ writeln( 'Compressed by DIET');π compressed := true;π END;π if (exehdr.Lpage > 0) thenπ exe_size := longint(exehdr.Fpages - 1) shl 9+exehdr.Lpageπ elseπ exe_size := longint(exehdr.Fpages) shl 9;π process_exefile;π ENDπ elseπ writeln('Not EXE file');π END; {procedure}ππCONSTπ blocksize = 1; { file r/w block size in one-byte unit }ππVARπ path : dirstr;π name : namestr;π ext : extstr;π fstr : string[48];π n : byte;ππBEGINπ if paramcount < 1 thenπ n := 0π elseπ n := 1;ππ fsplit(paramstr(n), path, name, ext);π if (name+ext = '*.*') or (name+ext = '.' ) or (name+ext = '' ) thenπ fstr := path+'*.exe'π elseπ if (path+ext = '') thenπ fstr := paramstr(n)+'.exe'π elseπ if not boolean(pos('.', ext)) thenπ BEGINπ path := path+name+'\';π fstr := path+'*.exe';π ENDπ elseπ fstr := paramstr(n);ππ n := 0;π{d} findfirst(fstr, anyfile, dirfile);π while (doserror = no_error) doπ BEGINπ if (dirfile.attr and volumeid <> volumeid) andπ (dirfile.attr and directory <> directory) andπ (dirfile.attr and sysfile <> sysfile) thenπ BEGINπ compressed := false;π Assign(f, path+dirfile.name); {$I-}π{d} Reset(f, blocksize); {$I+}π if (IOResult = no_error) thenπ BEGINπ writeln(cr, dirfile.name);π{d} BlockRead(f, exehdr, sizeof(exehdr), blocks_r);π if (blocks_r = sizeof(exehdr)) thenπ id_fileπ elseπ writeln('err:main');π close(f);π inc(n);π END;π END;π{d} findnext(dirfile);π END;ππ if (n = 0) thenπ if doserror = 3 thenπ writeln('path not found')π elseπ writeln('file not found')π elseπ writeln(n,' files found');πEND.π 7 05-26-9406:20ALL HENNING FUCHS BOOT Source SWAG9405 5 ┤φ πprocedure ColdBoot; assembler;πasmπ xor ax,axπ mov ds,axπ mov ah,$40π mov es,axπ mov word ptr es:$72,0π mov ax,$FFFFπ mov es,axπ xor si,siπ push axπ push siπ retfπend;ππprocedure WarmBoot; assembler;πasmπ xor ax,axπ mov ds,axπ mov ah,$40π mov es,axπ mov word ptr es:$72,$1234π mov ax,$FFFFπ mov es,axπ xor si,siπ push axπ push siπ retfπend;ππ
